Index: /ccr/trunk/p/CCRDPT.m =================================================================== --- /ccr/trunk/p/CCRDPT.m (revision 25) +++ /ccr/trunk/p/CCRDPT.m (revision 26) @@ -4,70 +4,72 @@ ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and ; DESTROY to clean-up. + + ; The first line of every routine tests if the global exists. - ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for - ; INIT 9 lines Copy DFN global to a local variable - ; DESTROY 6 lines Kill local variable - ; FAMILY 6 lines Family Name - ; GIVEN 6 lines Given Name - ; MIDDLE 6 lines Middle Name - ; SUFFIX 6 lines Suffi Name - ; DISPNAME 5 lines Display Name - ; DOB 6 lines Date of Birth - ; GENDER 4 lines Get Gender - ; SSN 4 lines Get SSN for ID - ; ADDRTYPE 4 lines Get Home Address - ; ADDR1 4 lines Get Home Address line 1 - ; ADDR2 5 lines Get Home Address line 2 - ; CITY 4 lines Get City for Home Address - ; STATE 11 lines Get State for Home Address - ; ZIP 4 lines Get Zip code for Home Address - ; COUNTY 4 lines Get County for our Address - ; COUNTRY 4 lines Get Country for our Address - ; RESTEL 4 lines Residential Telephone - ; WORKTEL 4 lines Work Telephone - ; EMAIL 4 lines Email Adddress - ; CELLTEL 4 lines Cell Phone - ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name - ; NOK1GIV 6 lines NOK1 Given Name - ; NOK1MID 6 lines NOK1 Middle Name - ; NOK1SUF 6 lines NOK1 Suffi Name - ; NOK1DISP 5 lines NOK1 Display Name - ; NOK1REL 4 lines NOK1 Relationship to the patient - ; NOK1ADD1 4 lines NOK1 Address 1 - ; NOK1ADD2 5 lines NOK1 Address 2 - ; NOK1CITY 4 lines NOK1 City - ; NOK1STAT 5 lines NOK1 State - ; NOK1ZIP 4 lines NOK1 Zip Code - ; NOK1HTEL; 4 lines NOK1 Home Telephone - ; NOK1WTEL; 4 lines NOK1 Work Telephone - ; NOK1SAME; 4 lines Is NOK1's Address the same the patient? - ; NOK2FAM 6 lines NOK2 Family Name - ; NOK2GIV 6 lines NOK2 Given Name - ; NOK2MID 6 lines NOK2 Middle Name - ; NOK2SUF 5 lines NOK2 Suffi Name - ; NOK2DISP 5 lines NOK2 Display Name - ; NOK2REL 4 lines NOK2 Relationship to the patient - ; NOK2ADD1 4 lines NOK2 Address 1 - ; NOK2ADD2 5 lines NOK2 Address 2 - ; NOK2CITY 4 lines NOK2 City - ; NOK2STAT 5 lines NOK2 State - ; NOK2ZIP 4 lines NOK2 Zip Code - ; NOK2HTEL; 4 lines NOK2 Home Telephone - ; NOK2WTEL; 4 lines NOK2 Work Telephone - ; NOK2SAME; 4 lines Is NOK2's Address the same the patient? - ; EMERFAM 6 lines Emergency Contact (EMER) Family Name - ; EMERGIV 6 lines EMER Given Name - ; EMERMID 6 lines EMER Middle Name - ; EMERSUF 5 lines EMER Suffi Name - ; EMERDISP 5 lines EMER Display Name - ; EMERREL 4 lines EMER Relationship to the patient - ; EMERADD1 4 lines EMER Address 1 - ; EMERADD2 5 lines EMER Address 2 - ; EMERCITY 4 lines EMER City - ; EMERSTAT 5 lines EMER State - ; EMERZIP 4 lines EMER Zip Code - ; EMERHTEL; 4 lines EMER Home Telephone - ; EMERWTEL; 4 lines EMER Work Telephone - ; EMERSAME; 4 lines Is EMER's Address the same the NOK? + ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for + ; INIT 9 lines Copy DFN global to a local variable + ; DESTROY 6 lines Kill local variable + ; FAMILY 6 lines Family Name + ; GIVEN 6 lines Given Name + ; MIDDLE 6 lines Middle Name + ; SUFFIX 6 lines Suffix Name + ; DISPNAME 5 lines Display Name + ; DOB 6 lines Date of Birth + ; GENDER 4 lines Get Gender + ; SSN 4 lines Get SSN for ID + ; ADDRTYPE 4 lines Get Home Address + ; ADDR1 4 lines Get Home Address line 1 + ; ADDR2 5 lines Get Home Address line 2 + ; CITY 4 lines Get City for Home Address + ; STATE 11 lines Get State for Home Address + ; ZIP 4 lines Get Zip code for Home Address + ; COUNTY 4 lines Get County for our Address + ; COUNTRY 4 lines Get Country for our Address + ; RESTEL 4 lines Residential Telephone + ; WORKTEL 4 lines Work Telephone + ; EMAIL 4 lines Email Adddress + ; CELLTEL 4 lines Cell Phone + ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name + ; NOK1GIV 6 lines NOK1 Given Name + ; NOK1MID 6 lines NOK1 Middle Name + ; NOK1SUF 6 lines NOK1 Suffi Name + ; NOK1DISP 5 lines NOK1 Display Name + ; NOK1REL 4 lines NOK1 Relationship to the patient + ; NOK1ADD1 4 lines NOK1 Address 1 + ; NOK1ADD2 5 lines NOK1 Address 2 + ; NOK1CITY 4 lines NOK1 City + ; NOK1STAT 5 lines NOK1 State + ; NOK1ZIP 4 lines NOK1 Zip Code + ; NOK1HTEL; 4 lines NOK1 Home Telephone + ; NOK1WTEL; 4 lines NOK1 Work Telephone + ; NOK1SAME; 4 lines Is NOK1's Address the same the patient? + ; NOK2FAM 6 lines NOK2 Family Name + ; NOK2GIV 6 lines NOK2 Given Name + ; NOK2MID 6 lines NOK2 Middle Name + ; NOK2SUF 5 lines NOK2 Suffi Name + ; NOK2DISP 5 lines NOK2 Display Name + ; NOK2REL 4 lines NOK2 Relationship to the patient + ; NOK2ADD1 4 lines NOK2 Address 1 + ; NOK2ADD2 5 lines NOK2 Address 2 + ; NOK2CITY 4 lines NOK2 City + ; NOK2STAT 5 lines NOK2 State + ; NOK2ZIP 4 lines NOK2 Zip Code + ; NOK2HTEL; 4 lines NOK2 Home Telephone + ; NOK2WTEL; 4 lines NOK2 Work Telephone + ; NOK2SAME; 4 lines Is NOK2's Address the same the patient? + ; EMERFAM 6 lines Emergency Contact (EMER) Family Name + ; EMERGIV 6 lines EMER Given Name + ; EMERMID 6 lines EMER Middle Name + ; EMERSUF 5 lines EMER Suffi Name + ; EMERDISP 5 lines EMER Display Name + ; EMERREL 4 lines EMER Relationship to the patient + ; EMERADD1 4 lines EMER Address 1 + ; EMERADD2 5 lines EMER Address 2 + ; EMERCITY 4 lines EMER City + ; EMERSTAT 5 lines EMER State + ; EMERZIP 4 lines EMER Zip Code + ; EMERHTEL; 4 lines EMER Home Telephone + ; EMERWTEL; 4 lines EMER Work Telephone + ; EMERSAME; 4 lines Is EMER's Address the same the NOK? W "No Entry at top!" Q @@ -165,4 +167,5 @@ FAMILY() ; Family Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" N NAME S NAME=$P(PT(0),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -171,4 +174,5 @@ GIVEN() ; Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" N NAME S NAME=$P(PT(0),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -177,4 +181,5 @@ MIDDLE() ; Middle Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" N NAME S NAME=$P(PT(0),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -183,4 +188,5 @@ SUFFIX() ; Suffi Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" N NAME S NAME=$P(PT(0),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -189,4 +195,5 @@ DISPNAME() ; Display Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" N NAME S NAME=$P(PT(0),"^",1) Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") @@ -194,4 +201,5 @@ DOB() ; Date of Birth; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" N DOB S DOB=$P(PT(0),"^",3) ; Date in FM Date Format. Convert to UTC/ISO 8601. @@ -200,16 +208,20 @@ GENDER() ; Get Gender; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" Q $P(PT(0),"^",2) ; SSN() ; Get SSN for ID; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(0))="" "" Q $P(PT(0),"^",9) ; ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic ; Vista only stores a home address for the patient. + Q:$G(PT(0))="" "" Q "Home" ; ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.11))="" "" Q $P(PT(.11),"^",1) ; @@ -217,12 +229,19 @@ ; PREREQ: PT Defined ; Vista has Lines 2,3; CCR has only line 1,2; so compromise + Q:$G(PT(.11))="" "" + ; If the thrid address is empty, just return the 2nd. + ; If the 2nd is empty, we don't lose, b/c it will return "" + ; This is so that we won't produce a comma if there is no 3rd addr. + Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2) Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3) ; CITY() ; Get City for Home Address; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.11))="" "" Q $P(PT(.11),"^",4) ; STATE() ; Get State for Home Address; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.11))="" "" ; State is stored as a pointer N STATENUM S STATENUM=$P(PT(.11),"^",5) @@ -232,36 +251,45 @@ ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2) ; ==>US STATE OR POSSESSION [6S] ^ + Q:STATENUM="" "" ; To prevent global undefined below if no state Q $P(^DIC(5,STATENUM,0),"^",1) ; ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.11))="" "" Q $P(PT(.11),"^",6) ; COUNTY() ; Get County for our Address; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.11))="" "" Q $P(PT(.11),"^",7) ; COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic ; Unfortunately, I can't find where that is stored, so the inevitable... + Q:$G(PT(.11))="" "" Q "USA" ; RESTEL() ; Residential Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.13))="" "" Q $P(PT(.13),"^",1) ; WORKTEL() ; Work Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.13))="" "" Q $P(PT(.13),"^",2) ; EMAIL() ; Email Adddress; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.13))="" "" Q $P(PT(.13),"^",3) ; CELLTEL() ; Cell Phone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.13))="" "" Q $P(PT(.13),"^",4) ; NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" N NAME S NAME=$P(PT(.21),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -270,4 +298,5 @@ NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" N NAME S NAME=$P(PT(.21),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -276,4 +305,5 @@ NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" N NAME S NAME=$P(PT(.21),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -282,4 +312,5 @@ NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" N NAME S NAME=$P(PT(.21),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -288,4 +319,5 @@ NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" N NAME S NAME=$P(PT(.21),"^",1) Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") @@ -293,8 +325,10 @@ NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" Q $P(PT(.21),"^",2) ; NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" Q $P(PT(.21),"^",3) ; @@ -302,39 +336,52 @@ ; PREREQ: PT Defined ; As before, CCR only allows two fileds for the address, so we have to compromise + Q:$G(PT(.21))="" "" + ; If the thrid address is empty, just return the 2nd. + ; If the 2nd is empty, we don't lose, b/c it will return "" + ; This is so that we won't produce a comma if there is no 3rd addr. + Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4) Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5) ; NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" Q $P(PT(.21),"^",6) ; NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" N STATENUM S STATENUM=$P(PT(.21),"^",7) + Q:STATENUM="" "" Q $P(^DIC(5,STATENUM,0),"^",1) ; NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" Q $P(PT(.21),"^",8) ; NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" Q $P(PT(.21),"^",9) ; NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" Q $P(PT(.21),"^",11) ; NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.21))="" "" Q $P(PT(.21),"^",10) ; NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" N NAME S NAME=$P(PT(.211),"^",1) D NAMECOMP^XLFNAME(.NAME) Q NAME("FAMILY") ; -NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined +NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" N NAME S NAME=$P(PT(.211),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -343,4 +390,5 @@ NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" N NAME S NAME=$P(PT(.211),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -349,4 +397,5 @@ NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" N NAME S NAME=$P(PT(.211),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -354,4 +403,5 @@ NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" N NAME S NAME=$P(PT(.211),"^",1) Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") @@ -359,8 +409,10 @@ NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" Q $P(PT(.211),"^",2) ; NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" Q $P(PT(.211),"^",3) ; @@ -368,33 +420,46 @@ ; PREREQ: PT Defined ; As before, CCR only allows two fileds for the address, so we have to compromise + Q:$G(PT(.211))="" "" + ; If the thrid address is empty, just return the 2nd. + ; If the 2nd is empty, we don't lose, b/c it will return "" + ; This is so that we won't produce a comma if there is no 3rd addr. + Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4) Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5) ; NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" Q $P(PT(.211),"^",6) ; NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" N STATENUM S STATENUM=$P(PT(.211),"^",7) + Q:STATENUM="" "" ; To prevent global undefined below if no state Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above ; NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" Q $P(PT(.211),"^",8) ; NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" Q $P(PT(.211),"^",9) ; NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" Q $P(PT(.211),"^",11) ; NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.211))="" "" Q $P(PT(.211),"^",10) ; EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" N NAME S NAME=$P(PT(.33),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -403,4 +468,5 @@ EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" N NAME S NAME=$P(PT(.33),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -409,4 +475,5 @@ EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" N NAME S NAME=$P(PT(.33),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -415,4 +482,5 @@ EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" N NAME S NAME=$P(PT(.33),"^",1) D NAMECOMP^XLFNAME(.NAME) @@ -420,4 +488,5 @@ EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" N NAME S NAME=$P(PT(.33),"^",1) Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") @@ -425,8 +494,10 @@ EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" Q $P(PT(.33),"^",2) ; EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" Q $P(PT(.33),"^",3) ; @@ -434,29 +505,41 @@ ; PREREQ: PT Defined ; As before, CCR only allows two fileds for the address, so we have to compromise + Q:$G(PT(.33))="" "" + ; If the thrid address is empty, just return the 2nd. + ; If the 2nd is empty, we don't lose, b/c it will return "" + ; This is so that we won't produce a comma if there is no 3rd addr. + Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4) Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5) ; EMERCITY() ; EMER City; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" Q $P(PT(.33),"^",6) ; EMERSTAT() ; EMER State; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" N STATENUM S STATENUM=$P(PT(.33),"^",7) + Q:STATENUM="" "" ; To prevent global undefined below if no state Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above ; EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" Q $P(PT(.33),"^",8) ; EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" Q $P(PT(.33),"^",9) ; EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" Q $P(PT(.33),"^",11) ; EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" Q $P(PT(.33),"^",10) ; Index: /ccr/trunk/p/CCRDPTT.m =================================================================== --- /ccr/trunk/p/CCRDPTT.m (revision 25) +++ /ccr/trunk/p/CCRDPTT.m (revision 26) @@ -13,8 +13,5 @@ ; Load Routine Entry points; We get a sweeeeeet array - N OUT D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory - ZWR OUT(,0) - N X,Y ; Select Patient @@ -24,5 +21,5 @@ D INIT^CCRDPT($P(Y,"^")) ZWR PT - N I S I=160 F S I=$O(OUT(I)) Q:I="" D + N I S I=165 F S I=$O(OUT(I)) Q:I="" D . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" " . W "valued at "