Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BKMVSUP

BKMVSUP.m

Go to the documentation of this file.
  1. BKMVSUP ;PRXM/HC/WOM - HIV SUPPLEMENT; [ 1/19/2005 7:16 PM ] ; 10 Jun 2005 12:02 PM
  1. ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
  1. Q
  1. ;
  1. EP(DFN) ;EP - Called by Health Summary Supplement
  1. ; Value for APCHSPAT is passed to identify the patient (DFN)
  1. ; IO variables will already have been set
  1. N X,BKMIEN,DIR,DIRUT
  1. S DFN=$G(DFN)
  1. Q:DFN=""
  1. K ^TMP("BKMSUPP",$J),^TMP("BKMVSUP",$J)
  1. S X=$O(^BKM(90451,"B",DFN,""))
  1. ;I X="" S X=$$ATAG^BQITDUTL(DFN,"HIV/AIDS") I 'X S X=""
  1. I X="" D:'$D(ZTQUEUED) Q
  1. . ;W !!?5,"HMS Patient Care Summary is not available. This patient does not"
  1. . ;W !?5,"have an active HIV diagnostic tag and/or is not in the HMS Register.",!
  1. . W !!?5,"HMS Patient Care Summary cannot be generated as selected patient"
  1. . W !?5,"is not in the HMS Register.",!
  1. ;
  1. ; Comment out the security check in the event that IHS reconsiders
  1. ; I '$$PRIV(DUZ) D Q
  1. ; . I $E(IOST)="C" D
  1. ; .. W !!,"Sorry, you are currently not an authorized HMS user."
  1. ; .. W !,"Please see your Security Administrator for access.",! H 2
  1. ;
  1. S BKMIEN=X_U_DFN,^TMP("BKMSUPP",$J,"IENS")=BKMIEN
  1. I $E(IOST)="C",IO=IO(0) D Q:$G(APCHSQIT)
  1. . W !!
  1. . S DIR("A")="HMS PATIENT CARE SUMMARY WILL NOW BE DISPLAYED (^ TO EXIT, RETURN TO CONTINUE)"
  1. . S DIR(0)="E" D ^DIR
  1. . I $D(DIRUT) S APCHSQIT=1 Q
  1. N LINE,PGCNT,LNCNT
  1. S (PGCNT,LNCNT)=1
  1. D EP2(DFN)
  1. D PRINT
  1. W @IOF K Y
  1. K ^TMP("BKMSUPP",$J),^TMP("BKMVSUP",$J)
  1. Q
  1. ;
  1. EP2(DFN) ; Get data and report for one patient
  1. ; Store lines to print in ^TMP("BKMVSUP",$J)
  1. N NOW,X,DA,Y,HLDBKM,AUPNPAT,AUDT,AUDATA,PTNAME,HRECNO,PAGES,BKMDT
  1. S X=$O(^BKM(90451,"B",DFN,""))
  1. ;I X="" S X=$$ATAG^BQITDUTL(DFN,"HIV/AIDS") I 'X S X=""
  1. I X="" D:'$D(ZTQUEUED) Q
  1. . ;W !!?5,"HMS Patient Care Summary is not available. This patient does not"
  1. . ;W !?5,"have an active HIV diagnostic tag and/or is not in the HMS Register.",!
  1. . W !!?5,"HMS Patient Care Summary cannot be generated as selected patient"
  1. . W !?5,"is not in the HMS Register.",!
  1. S (DA,Y)=X,HLDBKM=X_U_DFN
  1. K LOCAL,DIC,ICD9S
  1. D NOW^%DTC S NOW=X
  1. I +Y'<0 D GET^BKMVSRP1($P(HLDBKM,U)),GETDATA
  1. K LOCAL,ICD9S,^TMP("BKMSUPP",$J)
  1. Q
  1. ;
  1. PRINT ; Print report from ^TMP("BKMVSUP",$J)
  1. N PAGE,CNT,XNOW,QUIT
  1. U IO
  1. S PAGE="",CNT=""
  1. S QUIT="" ; Used to identify if user wants to quit display if run to the screen
  1. D NOW^%DTC S XNOW=$$FMTE^XLFDT(X,"5Z")
  1. F S PAGE=$O(^TMP("BKMVSUP",$J,PAGE)) Q:'PAGE D Q:QUIT
  1. . D HEADER^BKMVSUP6(PAGE,XNOW)
  1. . F S CNT=$O(^TMP("BKMVSUP",$J,PAGE,CNT)) D Q:'CNT!QUIT
  1. .. I 'CNT S QUIT=$$PAUSE^BKMVSUP3() Q
  1. .. W !,^TMP("BKMVSUP",$J,PAGE,CNT)
  1. I QUIT S APCHSQIT=1
  1. Q
  1. ;
  1. GETDATA ; Load data in ^TMP
  1. ;
  1. N A,DPTIEN,BKMIEN,CLCL,RDIAG,GETSIENS,BKMREG,LSTDXDT,A1,I,J,K,L,BKMDT,TEMP,MAXCT,BKM,BKMT
  1. N BMI,%H,DR,STCAT,STIEN,AGE,GLOBAL,CPRDT,CNT,CDDT,Y,CDTST,TYPE,BKMHAART,HIVDXDT,TMPDT
  1. N HPRV,HCSM,DBMI
  1. S MAXCT=IOSL-7
  1. ;
  1. S DPTIEN=$P(^TMP("BKMSUPP",$J,"IENS"),U,2),BKMIEN=$P(^TMP("BKMSUPP",$J,"IENS"),U)
  1. S GETSIENS=BKMIEN,DFN=DPTIEN
  1. S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1. ;
  1. ; Array LOCAL is set up with the following subscripts:
  1. ; LOCAL(2,DPTIEN,.01,"I")=name
  1. ; LOCAL(2,DPTIEN,.01,"E")=name
  1. ; LOCAL(2,DPTIEN,.02,"I")=sex...e.g. F for female
  1. ; LOCAL(2,DPTIEN,.03,"I")=date of birth in internal format
  1. ; LOCAL(9000001,BKMIEN,1102.98)=age
  1. ; LOCAL(9000001,BKMIEN,1118)=community
  1. ; LOCAL(90451,BKMIEN,.02,"E")=name
  1. ; LOCAL(90451,BKMIEN,.02,"I")=DPTIEN
  1. ; LOCAL(90451.01,"1,"_BKMIEN_",",.5,"E")=STATUS
  1. ; LOCAL(90451.01,"1,"_BKMIEN_",",2.3,"E")=DIAGNOSIS CATEGORY
  1. ; LOCAL(90451.01,"1,"_BKMIEN_",",4.1,"E")=STATE HIV CONFIRMATION STATUS
  1. ; LOCAL(90451.01,"1,"_BKMIEN_",",4.2,"E")=STATE HIV CONFIRMATION DATE
  1. ; LOCAL(90451.01,"1,"_BKMIEN_",",4.51,"E")=STATE AIDS ACKNOWLEDGEMENT STATUS
  1. ; LOCAL(90451.01,"1,"_BKMIEN_",",4.52,"E")=STATE AIDS ACKNOWLEDGEMENT DATE
  1. ; LOCAL("HRECNO")=HEALTH RECORD NUMBER
  1. ; LOCAL(90451.01,"1,"_BKMIEN_",",.015,"E")=FACILITY(WHERE FOLLOWS)
  1. ;
  1. S LINE=" Patient's Name: "_$E($G(LOCAL(2,DPTIEN,.01,"E")),1,30)
  1. S LINE=$$LINE(LINE,"HRN: ",46)_$E($G(LOCAL("HRECNO")),1,8)
  1. D UPD
  1. S LINE=" Sex: "_$G(LOCAL(2,DPTIEN,.02,"I"))
  1. S LINE=$$LINE(LINE,"DOB: ",19)
  1. S Y=LOCAL(2,DPTIEN,.03,"I") S LINE=LINE_$$FMTE^XLFDT(Y,"5Z")
  1. S AGE=$E($P($G(LOCAL(9000001,DPTIEN,1102.98))," "),1,3)
  1. S LINE=$$LINE(LINE,"Age: ",46)_AGE_$E($P($G(LOCAL(9000001,DPTIEN,1102.98))," ",2),1)
  1. D UPD
  1. S RDIAG=$P($$DPCP^BQIULPT(DFN),U,2)
  1. ;S RDIAG=$$GET1^DIQ(9000001,DFN,.14,"E")
  1. S LINE=" Designated Primary Care Provider: "_RDIAG
  1. D UPD
  1. K TEMP D GETS^DIQ(90451.01,1_","_+BKMIEN_",",".02;.5;.75;2;2.5;3;3.5;5;5.5;6;6.5","IE","TEMP")
  1. S LINE=" HIV Provider: "
  1. S HPRV=$$HPRV^BQIVFDEF(DFN) I HPRV S HPRV=$$GET1^DIQ(200,HPRV_",",.01,"E")
  1. S LINE=LINE_HPRV
  1. D UPD
  1. S LINE=" HIV Case Manager: "
  1. S HCSM=$$HCSM^BQIVFDEF(DFN) I HCSM S HCSM=$$GET1^DIQ(200,HCSM_",",.01,"E")
  1. S LINE=LINE_HCSM
  1. D UPD
  1. S RDIAG=$$HTWT^BKMVSUP2(DFN)
  1. S LINE=" Last Height: "_$P(RDIAG,U)_" "_$P(RDIAG,U,2)
  1. N POS,LEN
  1. S POS=30,LEN=$L(LINE) I LEN>28 S POS=LEN+2
  1. S LINE=$$LINE(LINE," Last Weight: ",POS)_$P(RDIAG,U,3)_" "_$P(RDIAG,U,4)
  1. D UPD
  1. ; Determine BMI
  1. ;S BMI=$$BMI(DFN,$P(RDIAG,U),$$DT($P(RDIAG,U,2)),$P(RDIAG,U,3),$$DT($P(RDIAG,U,4)),AGE)
  1. S DBMI=$$PBMI^APCLV(DFN,DT)
  1. S BMI=$P(DBMI,U,1)
  1. I BMI'="" S BMI=$J(BMI,3,2)
  1. ; if BMI cannot be set display the following
  1. I BMI="" S BMI="BMI cannot be calculated with current data. - "_$P(DBMI,U,8)
  1. S LINE=" BMI: "_BMI
  1. D UPD,BLANK(1)
  1. S LINE=" Register Diagnosis: "_$G(LOCAL(90451.01,1_","_+BKMIEN_",",2.3,"E"))
  1. ; Retrieve diagnosis date from diag cat history
  1. S LSTDXDT=$O(^BKM(90451,BKMIEN,1,BKMREG,10,"B",""),-1)
  1. I LSTDXDT S LINE=LINE_" "_$$FMTE^XLFDT(LSTDXDT\1,"5Z")
  1. D UPD
  1. S LINE=" Register Status: "_$$LOWER^VALM1($G(TEMP(90451.01,1_","_+BKMIEN_",",.5,"E")))
  1. I $G(TEMP(90451.01,1_","_+BKMIEN_",",.75,"I")) S LINE=LINE_" "_$P($$FMTE^XLFDT(TEMP(90451.01,1_","_+BKMIEN_",",.75,"I"),"5Z"),"@")
  1. D UPD
  1. S LINE=" HIV/ AIDS Diagnostic Tag Status: "_$$HIVTAG^BKMVSUP6(DFN)
  1. D UPD
  1. S LINE=" HIV Clinical Classification (A1-C3): "_$G(TEMP(90451.01,1_","_+BKMIEN_",",3,"E"))
  1. I $G(TEMP(90451.01,1_","_+BKMIEN_",",3.5,"I")) S LINE=LINE_" "_$P($$FMTE^XLFDT(TEMP(90451.01,1_","_+BKMIEN_",",3.5,"I"),"5Z"),"@")
  1. D UPD
  1. S LINE=" Diagnosis Comments: "_$$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",",2.7,"I")
  1. D UPD
  1. S LINE=" Initial HIV Diagnosis: "
  1. S HIVDXDT=$G(TEMP(90451.01,1_","_+BKMIEN_",",5,"I"))
  1. I HIVDXDT]"" S TMPDT=$$FMTE^XLFDT(HIVDXDT,"5Z") S:$P(TMPDT,"/",2)="00" TMPDT=$P(TMPDT,"/",1)_"/"_$P(TMPDT,"/",3) S LINE=LINE_TMPDT
  1. ; The default value for this field, if not populated, is yet to be worked out but will be displayed as value,"[**]",!
  1. D UPD
  1. S LINE=" Initial AIDS Diagnosis: "
  1. I $G(TEMP(90451.01,1_","_+BKMIEN_",",5.5,"I")) S TMPDT=$$FMTE^XLFDT(TEMP(90451.01,1_","_+BKMIEN_",",5.5,"I"),"5Z") S:$P(TMPDT,"/",2)="00" TMPDT=$P(TMPDT,"/",1)_"/"_$P(TMPDT,"/",3) S LINE=LINE_TMPDT
  1. ; The default value for this field, if not populated, is yet to be worked out but will be displayed as value,"[**]",!
  1. K TEMP
  1. ;
  1. OI ; Opportunistic Infections
  1. D UPD,BLANK(1)
  1. S LINE=" Opportunistic infections and AIDS Defining Illnesses"
  1. D UPD
  1. ; Modified code to use new structure for ICD9S array from BKMVC6.
  1. N DIC,DIQ,DR,DA,STDT,ICD9S,ICDDSC,PNARR,ICD,NAR,DASH,ENTDT
  1. S DASH="",$P(DASH,"-",79)=""
  1. D GETALL^BKMVSUP6(DFN) ; Returns the Opportunistic infections in local array ICD9S(ACTDATE,INDEX,"ICD9")=ICD
  1. ; Only look at opportunistic infections since initial HIV diagnosis date.
  1. ; If there is none look at last 6 months.
  1. ; *** Removed date check at request of IHS ***
  1. ; S STDT=$S(HIVDXDT]"":HIVDXDT,1:$$FMADD^XLFDT(DT,-183)),STDT=9999999-STDT
  1. I $D(ICD9S) D
  1. . S A1="",L=0
  1. . F S A1=$O(ICD9S(A1)) Q:A1="" D
  1. .. S BKMDT=$P($$FMTE^XLFDT(9999999-A1,"5Z"),"@")
  1. .. S K=""
  1. .. F S K=$O(ICD9S(A1,K)) Q:K="" D
  1. ... I 'L D
  1. .... I LNCNT>(MAXCT-2) D NEWPG
  1. .... S LINE=" Onset",LINE=$$LINE(LINE,"Entry",15),LINE=$$LINE(LINE,"ICD",27)
  1. .... S LINE=$$LINE(LINE,"ICD",35),LINE=$$LINE(LINE,"Provider",49)
  1. .... S LINE=$$LINE(LINE,"Status of",69) D UPD
  1. .... S LINE=" Date",LINE=$$LINE(LINE," Date",15),LINE=$$LINE(LINE,"Code",27)
  1. .... S LINE=$$LINE(LINE,"Narrative",35),LINE=$$LINE(LINE,"Narrative",49)
  1. .... S LINE=$$LINE(LINE," Problem",69) D UPD
  1. .... ;S LINE=" [Date]",LINE=$$LINE(LINE,"[ICD9]",20)
  1. .... ;S LINE=$$LINE(LINE,"[Description]",28),LINE=$$LINE(LINE,"[Status]",60)
  1. .... ;S LINE=$$LINE(LINE,"[Provider Narrative]",70)
  1. .... ;S LINE=$$LINE(LINE,"[Description]",28),LINE=$$LINE(LINE,"[Provider Narrative]",55)
  1. .... S LINE=DASH D UPD
  1. ... K ICD,NAR
  1. ... I $$VERSION^XPDUTL("BCSV") S ICDDSC=$$ICDD^BKMUL3("ICD9",K,9999999-A1) ; csv
  1. ... I '$$VERSION^XPDUTL("BCSV") S ICDDSC=$$GET1^DIQ(80,K,10,"E")
  1. ... D PARSE(ICDDSC,12,"ICD")
  1. ... S PNARR=$P($G(ICD9S(A1,K)),U,2) D PARSE(PNARR,18,"NAR")
  1. ... S LINE=" "_BKMDT,ENTDT=$P(ICD9S(A1,K),U,3)
  1. ... I ENTDT'="" S LINE=$$LINE(LINE,$$FMTE^XLFDT(ENTDT,"5Z"),15)
  1. ... I $$VERSION^XPDUTL("BCSV") S LINE=$$LINE(LINE,$$ICD9^BKMUL3(K,9999999-A1,2),27) ; csv
  1. ... I '$$VERSION^XPDUTL("BCSV") S LINE=$$LINE(LINE,$$GET1^DIQ(80,K,.01,"E"),27)
  1. ... ;S LINE=$$LINE(LINE,BKMDT,5),LINE=$$LINE(LINE,$$ICD9^BKMUL3(K,9999999-A1,2),20) ; csv
  1. ... S LINE=$$LINE(LINE,$G(ICD(1)),35),LINE=$$LINE(LINE,$G(NAR(1)),49)
  1. ... ;S LINE=$$LINE(LINE,$E($$ICDD^BKMUL3("ICD9",K,9999999-A1),1,25),28) ; csv
  1. ... ; S LINE=$$LINE(LINE,BKMDT,5),LINE=$$LINE(LINE,$$GET1^DIQ(80,K,.01,"E"),20)
  1. ... ; S LINE=$$LINE(LINE,$E($$GET1^DIQ(80,K,10,"E"),1,25),28)
  1. ... S LINE=$$LINE(LINE,$P($G(ICD9S(A1,K)),U),69)
  1. ... ;S LINE=$$LINE(LINE,$P($G(ICD9S(A1,K)),U),60),LINE=$$LINE(LINE,$P($G(ICD9S(A1,K)),U,2),70)
  1. ... ;S LINE=$$LINE(LINE,$$G(ICD9S(A1,K)),55)
  1. ... D UPD
  1. ... S L=1
  1. ... I LNCNT>MAXCT D NEWPG
  1. ... I $O(ICD(1))!$O(NAR(1)) D
  1. .... N IX
  1. .... F IX=2:1 Q:'$D(ICD(IX))&'$D(NAR(IX)) D
  1. ..... S LINE=""
  1. ..... I $D(ICD(IX)) S LINE=$$LINE(LINE,ICD(IX),35)
  1. ..... I $D(NAR(IX)) S LINE=$$LINE(LINE,NAR(IX),49)
  1. ..... D UPD
  1. ; PRXM/HC/ALA Modified 9/22/2005
  1. D GETS^DIQ(90451.01,"1,"_+BKMIEN_",","4;4.1;4.2;4.3;4.5;4.51;4.52;4.53","EI","STCAT")
  1. D UPD S LINE=" State Notification(s): "
  1. I $G(STCAT("90451.01","1,"_+BKMIEN_",","4.3","E"))'="" D
  1. . S LINE=$$LINE(LINE,"HIV ",23)_$G(STCAT(90451.01,"1,"_+BKMIEN_",","4.3","E"))
  1. . I $G(STCAT(90451.01,"1,"_+BKMIEN_",","4","I")) S LINE=LINE_" "_$$FMTE^XLFDT(STCAT(90451.01,"1,"_+BKMIEN_",","4","I"),"5Z")
  1. . D UPD
  1. I $G(STCAT("90451.01","1,"_+BKMIEN_",","4.53","E"))'="" D
  1. . S LINE=$$LINE(LINE,"AIDS ",23)_$G(STCAT(90451.01,"1,"_+BKMIEN_",","4.53","E"))
  1. . I $G(STCAT(90451.01,"1,"_+BKMIEN_",","4.5","I")) S LINE=LINE_" "_$$FMTE^XLFDT(STCAT(90451.01,"1,"_+BKMIEN_",","4.5","I"),"5Z")
  1. . D UPD
  1. . I LNCNT>MAXCT D NEWPG
  1. I $G(STCAT("90451.01","1,"_+BKMIEN_",","4.3","E"))="",$G(STCAT("90451.01","1,"_+BKMIEN_",","4.53","E"))="" D UPD ;W !
  1. I LNCNT>MAXCT D NEWPG
  1. S LINE=" Partner Notification: "
  1. S BKM=$$GET1^DIQ(90451.01,"1,"_+BKMIEN_",",15,"E") S LINE=LINE_BKM
  1. S BKM=$$FMTE^XLFDT($$GET1^DIQ(90451.01,"1,"_+BKMIEN_",",16,"I"),"5Z") S LINE=LINE_" "_BKM
  1. ;S BKM=$$GET1^DIQ(90451.01,"1,"_+BKMIEN_",",15,"E") S LINE=LINE_BKM
  1. D UPD
  1. I LNCNT>MAXCT D NEWPG
  1. ;
  1. ; Begin LAB RESULTS
  1. ; Variable QUIT is initialized in ONEY/ONE and reset based on user's response to press enter to continue
  1. ; Variable MAXCT is set by PRINT to IOSL-4
  1. I LNCNT>(MAXCT-2) D NEWPG
  1. D UPD S LINE=" RECENT LABORATORY RESULTS: "
  1. D UPD,BLANK(1) ;,!,!
  1. I LNCNT>MAXCT D NEWPG
  1. D CD4^BKMVSUP1(DFN)
  1. D VIRAL^BKMVSUP1(DFN)
  1. D LIPID^BKMVSUP6(DFN)
  1. D RPR^BKMVSUP1(DFN)
  1. D PAP^BKMVSUP1(DFN)
  1. D CHL^BKMVSUP1(DFN)
  1. D GON^BKMVSUP1(DFN)
  1. D HEP^BKMVSUP4(DFN)
  1. D HEPA^BKMVSUP4(DFN)
  1. D HEPB^BKMVSUP4(DFN)
  1. D HEPC^BKMVSUP4(DFN)
  1. D CMV^BKMVSUP1(DFN)
  1. D TOX^BKMVSUP1(DFN)
  1. D COC^BKMVSUP1(DFN)
  1. D PPD^BKMVSUP1(DFN)
  1. D PHENO^BKMVSUP1(DFN)
  1. D GENO^BKMVSUP1(DFN)
  1. ; Immunizations
  1. D IMM^BKMVSUP2(DFN)
  1. ; Medications
  1. D DRUGS^BKMVSUP3(DFN)
  1. ; Screenings
  1. D SCREENS^BKMVSUP2(DFN)
  1. ; Eye exam
  1. D RET^BKMVSUP3(DFN)
  1. ; Print Dental exam date
  1. D DEN^BKMVSUP3(DFN)
  1. ; Print Mammogram date
  1. D MAM^BKMVSUP3(DFN)
  1. ; Print HIV Education
  1. D ED^BKMVSUP5(DFN)
  1. ; Print Reminders
  1. D REM^BKMVSUP5(DFN)
  1. ; Print Flow Sheet
  1. D FLOW^BKMVSUP5(DFN)
  1. D BLANK(2)
  1. S LINE=" "_$E($$CONF^BKMVSUP6(1),1,78) D UPD ;Write end confidential message
  1. Q
  1. ;
  1. BMI(PT,HT,HTD,WT,WTD,AGE) ; Calculate BMI
  1. Q
  1. ; PT = patient's DFN
  1. ; HT = patient's height
  1. ; HTD = date patient's height was recorded
  1. ; WT = patient's weight
  1. ; WTD = date patient's weight was recorded
  1. ; AGE = patient's age (taken from 9000001,1102.98)
  1. ;
  1. ;N BMI,WDIFF,HDIFF
  1. ;I PT=""!(HT="")!(WT="")!(AGE="") Q ""
  1. ; Patients younger than 19 must have both measurements on the same day
  1. ;I AGE<19,HTD'=WTD Q ""
  1. ;S WDIFF=$$FMDIFF^XLFDT(DT,WTD,1)
  1. ;S HDIFF=$$FMDIFF^XLFDT(DT,HTD,1)
  1. ; Patients older than 50 must have both measurements in the last two years
  1. ;I AGE>50,WDIFF>(2*365)!(HDIFF>(2*365)) Q ""
  1. ; Patients between 19 and 50 must have both measurements in the last five years
  1. ;I AGE<50,AGE>18,WDIFF>(5*365)!(HDIFF>(5*365)) Q ""
  1. ;S BMI=$$BMI^APCHS2A3(PT,WT,DT)
  1. ;Q $$STRIP^XLFSTR($P(BMI,U,1)," ")
  1. ; S WT=WT*.45359,HT=HT*.0254 ;Convert to metric
  1. ; Q $J(WT/(HT*HT),0,1)
  1. ;
  1. LINE(TEXT,STR,POS) ; Set text to match HMS Supplement formatting
  1. I $L(TEXT)>POS Q TEXT_STR
  1. S $E(TEXT,POS)=STR
  1. Q TEXT
  1. ;
  1. UPD ; Update global with line of text; update page and total line count
  1. I LNCNT>MAXCT D NEWPG
  1. S ^TMP("BKMVSUP",$J,PGCNT,LNCNT)=LINE,LINE="",LNCNT=LNCNT+1
  1. Q
  1. ;
  1. NEWPG ; Print new page
  1. S PGCNT=PGCNT+1,LNCNT=1
  1. Q
  1. ;
  1. BLANK(CNT) ; Add blank line(s) to output global
  1. S CNT=$G(CNT,1)
  1. F I=1:1:CNT S ^TMP("BKMVSUP",$J,PGCNT,LNCNT)="",LNCNT=LNCNT+1
  1. Q
  1. ;
  1. DT(FDT) ; Date conversion
  1. N %DT,X,Y
  1. S %DT="TS",X=FDT D ^%DT
  1. Q Y
  1. ;
  1. PRIV(BKMDUZ) ; EP - Determine if user has access rights in HMS
  1. ; Extrinsic function - returns 1 (ability to access HMS data) or
  1. ; 0 (no HMS security access established)
  1. ; Input:
  1. ; BKMDUZ - DUZ, IEN for File 200
  1. ; Output: n/a
  1. ;
  1. N BKMHIV,BKMPRV,BKMPRIV
  1. S BKMPRIV=""
  1. S BKMHIV=$$HIVIEN^BKMIXX3()
  1. I BKMHIV'="",$G(BKMDUZ)'="" D
  1. . S BKMPRV=$O(^BKM(90450,BKMHIV,11,"B",$G(BKMDUZ),0))
  1. . I BKMPRV'="" S BKMPRIV=$P(^BKM(90450,BKMHIV,11,BKMPRV,0),"^",2)
  1. S BKMPRIV=$S(BKMPRIV="":0,1:1)
  1. Q BKMPRIV
  1. ;
  1. PARSE(STR,LEN,TARGET) ; Break up text by length and store in provided TARGET
  1. ;
  1. I $G(STR)="" Q
  1. I '$G(LEN) Q
  1. I $G(TARGET)="" Q
  1. N I,PC,STR1,CNT
  1. S CNT=0,STR1=""
  1. F I=1:1:$L(STR," ") S PC=$P(STR," ",I) I PC'="" D
  1. . I STR1="",$L(PC)>LEN S CNT=CNT+1,@TARGET@(CNT)=$E(PC,1,LEN),STR1=$E(PC,LEN+2,999)_" " Q
  1. . I $L(STR1_PC)>LEN S CNT=CNT+1,@TARGET@(CNT)=$$TKO^BQIUL1(STR1," "),STR1=PC_" " Q
  1. . S STR1=STR1_PC_" "
  1. I STR1'="" S CNT=CNT+1,@TARGET@(CNT)=$$TKO^BQIUL1(STR1," ")
  1. Q
  1. ;
  1. XIT ; Exit from routine
  1. Q